home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / prntutil / printpar / printpar.pas < prev    next >
Pascal/Delphi Source File  |  1995-04-25  |  12KB  |  368 lines
  1. {$A+,D-,S0}
  2.  
  3. Program Print;
  4.  
  5. {$I e:\pascal\include\Gemsubs.pas}
  6.  
  7. CONST
  8.    maxlines       = 5;
  9.    AC_Open        = 40;
  10.    BEG_Mctrl      = 3;
  11.    END_Mctrl      = 2;
  12.  
  13. VAR
  14.    working                                 : String[249];
  15.    defpath, inpath, linestr, test          : STRING;
  16.     char_wide, char_height, bch, bcw,
  17.     ap_id, menu_id, pagecount, linecount,
  18.     counter, title_1, prompt_1, prompt_2,
  19.     prompt_3, window, cancel_btn, drive,
  20.     rez, choice                            : INTEGER;
  21.     program_name                           : Str255;
  22.     Stop_PRINT, accloop, doneprt           : BOOLEAN;
  23.     msg                                    : Message_Buffer;
  24.     print_dialog                           : Dialog_Ptr;
  25.  
  26.  
  27. PROCEDURE IO_Check( b : BOOLEAN );
  28.    EXTERNAL;
  29.  
  30.  
  31. FUNCTION IO_Result : INTEGER;
  32.    EXTERNAL;
  33.  
  34.  
  35. FUNCTION CurDrv : INTEGER;
  36.    GEMDOS( $19 );
  37.  
  38.  
  39. FUNCTION GetRez : INTEGER;
  40.    XBIOS( 4 );
  41.  
  42. PROCEDURE Obj_Draw ( BOX : Dialog_Ptr; Item : Tree_Index;
  43.                      DEPTH, X, Y, W, H : INTEGER );
  44.    EXTERNAL;
  45.  
  46. PROCEDURE WIND_Update ( ctrl : INTEGER );
  47. VAR
  48.    int_in   : Int_In_Parms;
  49.    int_out  : Int_Out_Parms;
  50.    addr_in  : Addr_In_Parms;
  51.    addr_out : Addr_Out_Parms;
  52. BEGIN
  53.    int_in[0] := ctrl;
  54.    AES_Call( 107, int_in, int_out, addr_in, addr_out );
  55. END;
  56.  
  57.  
  58. { This procedure is where the accessory waits for a mesaage to activate }
  59. { and start to print a file. }
  60.  
  61. PROCEDURE Event_Loop;
  62. VAR
  63.     event, dummy : INTEGER;
  64.     again : BOOLEAN;
  65. BEGIN
  66.    again := FALSE;
  67.    REPEAT
  68.       event := Get_Event( E_Message,0,0,0,0,FALSE,0,0,0,0,
  69.                           FALSE,0,0,0,0,msg,
  70.                           dummy,dummy,dummy,dummy,dummy,dummy );
  71.   { Open up only if "OPEN" message has been received, and the proper menu }
  72.   { identification number is given! }
  73.       IF (msg[0] = AC_Open) AND (msg[4] = menu_id) THEN
  74.           again := TRUE;
  75.    UNTIL again;
  76. END;
  77.  
  78.  
  79. { This procedure converts an INTEGER number into a string }
  80.  
  81. PROCEDURE Convert( number : INTEGER; VAR tempstr : STRING );
  82. VAR
  83.    temp : STRING;
  84.    tempnum, count1, count2,
  85.    divideby : INTEGER;
  86.    first : BOOLEAN;
  87.  
  88.    PROCEDURE Num( whatnum : Integer ; VAR str : string ) ;
  89.    CONST
  90.       numbers = '123456789';
  91.    BEGIN
  92.       IF whatnum = 0 THEN
  93.          str := '0'
  94.       ELSE
  95.          str := Copy( numbers, whatnum, 1);
  96.    END;
  97.  
  98. BEGIN
  99.    tempstr := '';
  100.    first := true;
  101.    FOR count1 := maxlines DOWNTO 1 DO BEGIN
  102.        divideby := 1;
  103.        FOR count2 := 1 TO count1 DO
  104.           divideby := divideby*10;
  105.        tempnum := number div divideby;
  106.        number := number mod divideby;
  107.        Num( tempnum, temp );
  108.        IF tempnum>0 THEN
  109.           first := false;
  110.        IF NOT first THEN
  111.           tempstr := Concat( tempstr, temp );
  112.    END ;
  113.    Num( number, temp );
  114.    tempstr := Concat( tempstr, temp );
  115. END;
  116.  
  117.  
  118. { This function asks whether you want to stop the printing.... If so, it }
  119. { returns TRUE to the asking procedure. }
  120.  
  121. FUNCTION AskStop : Boolean ;
  122. VAR
  123.     choice : INTEGER;
  124.     str : Str255;
  125. BEGIN
  126.    str := '[2][ |Do you wish to STOP printing?][ Yes | No ]';
  127.    choice := Do_Alert( str,2 );
  128.    IF choice = 1 THEN
  129.       AskStop := TRUE
  130.    ELSE
  131.       AskStop := FALSE
  132. END;
  133.  
  134.  
  135. { This procedure prints one line on the printer.  It also then loops back }
  136. { to GEM to see if either the UNDO key has been pressed, or whether the }
  137. { left mouse button has been pressed over the "CANCEL" box. If either these }
  138. { conditions have been met, it then asks you if you want to terminate the }
  139. { printing. }
  140.  
  141. PROCEDURE Println( str : Str255 ) ;
  142. VAR
  143.    event, what_key, bcnt, bstate,
  144.       mx, my, kbd : INTEGER;
  145. BEGIN
  146.    event := Get_Event( E_Keyboard|E_Timer|E_Button,
  147.                        1, 1, 1, 0,
  148.                        FALSE, 0, 0, 0, 0,
  149.                        FALSE, 0, 0, 0, 0,
  150.                        msg, what_key, bcnt,
  151.                        bstate, mx, my, kbd );
  152.    IF (event & E_Keyboard <> 0 ) THEN
  153.       IF (NOT Stop_PRINT) AND ((what_key = $6100) OR (what_key = $1C0D)) THEN
  154.          Stop_PRINT := AskStop;
  155.    IF (event & E_Button <> 0) AND (bcnt>0) AND
  156.       (mx > (35*char_wide)) AND
  157.       (mx < (45*char_wide)) AND
  158.       (my > (16*char_height + char_height DIV 2)) AND
  159.       (my < (18*char_height + char_height DIV 2)) AND
  160.       (NOT Stop_PRINT) THEN
  161.       Stop_PRINT := AskStop ;
  162.    IF (NOT Stop_PRINT) THEN BEGIN
  163.       IF Length( str ) = 80 THEN
  164.          Write( str )
  165.       ELSE
  166.          Writeln( str );
  167.    END;
  168. END;
  169.  
  170.  
  171. { This procedure writes a passed string (numbers is this program) on the }
  172. { screen in the interactive dialog box. Note that the mouse is hide as the}
  173. { string is printed. }
  174.  
  175. PROCEDURE ListMessage( str : Str255 ; pos : INTEGER );
  176. VAR
  177.    len, c : INTEGER;
  178. BEGIN
  179.    len := Length(str);
  180.    IF len < 14 THEN
  181.       FOR c := 1 TO 14-len DO
  182.          str := Concat( str, ' ' );
  183.    Hide_Mouse;
  184.    Draw_String( 40*char_wide, (11 + pos)*char_height + char_height DIV 3 + 1,
  185.                  str );
  186.    Show_Mouse;
  187. END;
  188.  
  189. { This procedure prints the page header on the top of each new page. }
  190.  
  191. PROCEDURE Header;
  192. VAR
  193.     temp1, temp2 : STRING;
  194.     counter : INTEGER;
  195.     
  196. BEGIN
  197.    temp1 := inpath;
  198.    Convert( pagecount, temp2 );
  199.    ListMessage( temp2, 4 );
  200.    FOR counter := 74-Length(temp2) DOWNTO Length(temp1) DO
  201.       temp1 := Concat(temp1,' ');
  202.    Insert( 'Page ', temp1, 74-Length(temp2) );
  203.    Insert( temp2, temp1, 79-Length(temp2) );
  204.    Println( temp1 );
  205.    Println( '' );
  206.    Println( '' );
  207. END;
  208.  
  209.  
  210. { This procedure sets up the items needed for the interactive dialog box }
  211. { to be drawn. }
  212.  
  213. PROCEDURE Setup_Dialog;
  214. BEGIN
  215.    print_dialog := New_Dialog( 10, 0, 0, 32, 13 );
  216.    title_1 := Add_DItem( print_dialog, G_String, None, 5, 1,
  217.               22, 1, 0, $1180 );
  218.    prompt_1 := Add_DItem( print_dialog, G_String, None, 3, 4,
  219.                30, 1, 0, $1180 );
  220.    prompt_2 := Add_DItem( print_dialog, G_String, None, 3, 6,
  221.                15, 1, 0, $1180 );
  222.    prompt_3 := Add_DItem( print_dialog, G_String, None, 3, 8,
  223.                15, 1, 0, $1180 );
  224.    cancel_btn := Add_DItem( print_dialog, G_BoxText,
  225.                Selectable|Default|Exit_Btn, 11, 10, 10, 2, 2, $1180 );
  226. END;
  227.  
  228.  
  229.  { This procedure finds the file name in the path to the file to be printed }
  230.  { and concatenates it the the passed string. }
  231.  
  232. PROCEDURE Add_Path (VAR str : Str255 ) ;
  233. VAR
  234.    len, x : INTEGER;
  235.    
  236. BEGIN
  237.    len := Length( inpath );
  238.    LOOP
  239.       EXIT IF (inpath[ len ] = '\') OR (len = 1);
  240.       len := len - 1;
  241.    END;
  242.    str := '  File Name: ';
  243.    FOR x := (len + 1) TO Length( inpath )  DO
  244.        str := Concat( str, inpath[ x ] ) ;
  245. END;
  246.  
  247.  
  248. { This procedure first attempts to open up a window the full size fo the }
  249. { screen. This is necessary to prevent GEM from misdirecting button }
  250. { presses for the interactive dialog box to the windows beneath the box. }
  251. { Whether the window is opened successfully or not, the dialog box is then }
  252. { drawn on the screen. }
  253.  
  254. PROCEDURE ShowProgress ;
  255. VAR
  256.    str : Str255;
  257.  
  258. BEGIN
  259.    Set_DText( print_dialog, title_1,
  260.               'Currently PRINTING File', System_Font, TE_Center );
  261.    Add_Path ( str );
  262.    Set_DText( print_dialog, prompt_1, str, System_Font, TE_Right ) ;
  263.    Set_DText( print_dialog, prompt_2,
  264.               ' Line Count:', System_Font, TE_Right ) ;
  265.    Set_DText( print_dialog, prompt_3,
  266.               'Page Number:', System_Font, TE_Right ) ;
  267.    Set_DText( print_dialog, cancel_btn, 'CANCEL',
  268.               System_Font, TE_Center ) ;
  269.    Obj_SetState( print_dialog, cancel_btn, Normal, FALSE ) ;
  270.    Text_Color( Black ) ;
  271.    Center_Dialog( print_dialog ) ;
  272.    Obj_Draw( print_dialog, 0, 1, 0, 0, 80*char_wide, 24*char_height ) ;
  273. END;
  274.  
  275.  
  276. { This is the main program. }
  277.  
  278. BEGIN
  279.    program_name := '  Serial File Printer';
  280.    ap_id := Init_Gem;  { Initialize GEM and register our accessoary }
  281.    menu_id := 0;
  282.    IF ( ap_id>0 ) THEN  { If we are an accessory, add name to Desk menu }
  283.       menu_id := Menu_Register( ap_id, program_name );
  284.    IF (ap_id >= 0) AND (menu_id >=0) THEN BEGIN
  285.       { Get the current screen characteristics for positioning later }
  286.       IF (ap_id>0) THEN
  287.          accloop := TRUE  { We are an accessory }
  288.       ELSE
  289.          accloop := FALSE; { We are a program }
  290.       Sys_Font_Size( char_wide, char_height, bcw, bch );
  291.       rez := GetRez;
  292.       IF rez = 0 THEN
  293.          char_wide := char_wide DIV 2;
  294.       doneprt := TRUE;
  295.       REPEAT
  296.          IF accloop AND doneprt THEN  { If we are an accessory, wait to be selected }
  297.             Event_Loop; { Loop until called }
  298.          pagecount := 1;  { Initialize our page/line counts for printing }
  299.          linecount := 1;
  300.          choice := 1;
  301.          drive := CurDrv;  { Find the current drive; If "A" or "B" }
  302.          IF drive < 2 THEN { ask the user to insert a diskette }
  303.             choice := Do_Alert('[3][ | |Insert Source Disk][ OK | Cancel ]', 1)
  304.          ELSE
  305.             choice := 1;
  306.          IF choice = 1 THEN BEGIN
  307.             defpath := 'A:\*.*';
  308.             defpath[1] := Chr( Ord(defpath[1]) + drive );
  309.             IF Get_In_File( defpath, inpath ) THEN BEGIN  { Get the file path }
  310.                test := Copy( inpath, Length(inpath), 1 ); { to print }
  311.                doneprt := FALSE;
  312.                IF test<>'\' THEN BEGIN
  313.                   IO_check( FALSE ) ; { Find out whether line numbers are to be }
  314.                   choice := Do_Alert  { added, and give one more way to stop prg}
  315.                      ('[2][ |Do you want line numbers?][ No | Yes | Cancel ]',1);
  316.                   Reset( Input, inpath ) ;
  317.                   IF ( IO_Result <> 0 ) THEN
  318.                      choice := 3; { If there is an error }
  319.                   IF ( choice < 3 ) THEN BEGIN  { open, bomb out. }
  320.                      WIND_Update( BEG_Mctrl ) ; { Stop the screen manager }
  321.                      Setup_Dialog;
  322.                      Stop_PRINT := FALSE;
  323.                      ShowProgress; { Initialize the interactive dialog box }
  324.                      ListMessage( '1', 2 );
  325.                      ListMessage( '1', 4 );
  326.                      Rewrite( Output, 'PRN:' ); { Open the printer for output }
  327.                      Header;         { Print the initial header }
  328.                      counter := 1;
  329.                      REPEAT
  330.                         Readln( working );
  331.                         IF IO_Result <> 0 THEN
  332.                            Stop_PRINT := TRUE;
  333.                         IF (NOT Stop_PRINT) THEN BEGIN
  334.                            Convert( linecount, linestr );{ Now loop, printing each }
  335.                            ListMessage( linestr, 2 );    {line, then reading the next }
  336.                            IF ( choice=2 ) THEN BEGIN    {until done, or stop message}
  337.                               While Length(linestr)<5 DO { received. }
  338.                                  linestr := Concat( linestr, ' ' );
  339.                               working := Concat( linestr, ' ', working );
  340.                            END;
  341.                            Println( working );
  342.                            linecount := linecount + 1;
  343.                            counter := counter + (Length(working) DIV 81) + 1;
  344.                            IF counter>60 THEN BEGIN { Allow 60 lines per page }
  345.                               pagecount := pagecount+1;
  346.                               Println( Chr(12) ); { Do a form feed }
  347.                               Header;
  348.                               counter := 1;
  349.                            END;
  350.                         END;
  351.                      UNTIL EOF OR Stop_PRINT;
  352.                      Writeln( Chr(12) ); { End printing with a Form Feed }
  353.                      Close( Output );
  354.                      Close( Input );
  355.                      End_Dialog( print_dialog );
  356.                      Delete_Dialog( print_dialog );
  357.                      WIND_Update( END_Mctrl ); { Restart the Screen Manager }
  358.                   END; { if choice < 3 }
  359.                END; { if test <> '\' }
  360.             END  { if get_in_file }
  361.             ELSE
  362.               doneprt := TRUE;
  363.          END; { if choice = 1 }
  364.       UNTIL ((NOT accloop) AND doneprt);
  365.    END; { if ap_id }
  366.    Exit_GEM; { Exit gem only if we cannot register our accessory. }
  367. END.
  368.